unitfiles.pas

不错的远程控制程序

unit UnitFiles;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Variants,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  ComCtrls,
  StdCtrls,
  ExtCtrls,
  Sockets,
  CompressionStreamUnitForms,
  Menus,
  UnitSearch,
  ShellAPI,
  ImgList, ToolWin;

type
  TFiles = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    ComboBox1: TComboBox;
    ListView2: TListView;
    ListView1: TListView;
    PopupMenu1: TPopupMenu;
    Refresh1: TMenuItem;
    PopupMenu2: TPopupMenu;
    Search1: TMenuItem;
    Rename1: TMenuItem;
    Delete1: TMenuItem;
    N1: TMenuItem;
    PopupMenu3: TPopupMenu;
    Open1: TMenuItem;
    Normal1: TMenuItem;
    Hidden1: TMenuItem;
    N2: TMenuItem;
    Rename2: TMenuItem;
    Delete2: TMenuItem;
    N3: TMenuItem;
    Upload1: TMenuItem;
    Download1: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    Refresh2: TMenuItem;
    NewFolder1: TMenuItem;
    Parameters1: TMenuItem;
    Splitter1: TSplitter;
    ImageList2: TImageList;
    ImageList1: TImageList;
    ImageList6: TImageList;
    ImageList7: TImageList;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    Panel3: TPanel;
    Label1: TLabel;
    ToolBar2: TToolBar;
    FileToolButton3: TToolButton;
    FileToolButton4: TToolButton;
    ToolButton38: TToolButton;
    FileToolButton6: TToolButton;
    ToolButton40: TToolButton;
    FileToolButton7: TToolButton;
    FileToolButton8: TToolButton;
    ToolButton47: TToolButton;
    FileToolButton9: TToolButton;
    ToolButton46: TToolButton;
    ToolButton48: TToolButton;
    ImageList3: TImageList;
    ImageList5: TImageList;
    ToolBar3: TToolBar;
    FileToolButton10: TToolButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDeactivate(Sender: TObject);
    procedure Refresh1Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure ListView2DblClick(Sender: TObject);
    procedure ListView2Compare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
    procedure ListView2Edited(Sender: TObject; Item: TListItem;
      var S: string);
    procedure Rename1Click(Sender: TObject);
    procedure Delete1Click(Sender: TObject);
    procedure ListView1Edited(Sender: TObject; Item: TListItem;
      var S: string);
    procedure Delete2Click(Sender: TObject);
    procedure Refresh2Click(Sender: TObject);
    procedure PopupMenu2Popup(Sender: TObject);
    procedure PopupMenu3Popup(Sender: TObject);
    procedure NewFolder1Click(Sender: TObject);
    procedure Normal1Click(Sender: TObject);
    procedure Hidden1Click(Sender: TObject);
    procedure Rename2Click(Sender: TObject);
    procedure Download1Click(Sender: TObject);
    procedure Upload1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Search1Click(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure ComboBox1KeyPress(Sender: TObject; var Key: Char);
    procedure N7Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
  private
    { Private declarations }
    DataSocket: TCustomWinSocket;
    Connected: Boolean;
    ConnectNotifyInfo: TNotifyInfo;
    ReadNotifyInfo: TNotifyInfo;
    DisconnectNotifyInfo: TNotifyInfo;
    CurrentDirectory: string;
    SearchWindow: TSearch;
    Downloading: Boolean;
    procedure Connect(var Socket: TCustomWinSocket; Data: Pointer);
    procedure Read(var Socket: TCustomWinSocket; CommandFrame: TCommandFrame; Stream: TMemoryStream; Data: Pointer);
    procedure Disconnect(var Socket: TCustomWinSocket; Data: Pointer);
    procedure DoUpload(FileName: string);
    function SocketConnected: Boolean;
  public
    { Public declarations }
    RemoteAddress: string;
    WindowItem: TListItem;
    MainSocket: TCustomWinSocket;
    OldWindowProc: Classes.TWndMethod;
    procedure WMDROPFILES(var Msg: Messages.TMessage);
    procedure WindowProc(var Message: Messages.TMessage);
  end;

implementation

{$R *.dfm}

uses
  UnitMain;

{$WARNINGS OFF}

const
  F_TYPE = 15;
  F_DRIVES = 1;
  F_LIST = 2;
  F_RENAMEDIR = 3;
  F_DELETEDIR = 4;
  F_RENAMEFILE = 5;
  F_DELETEFILE = 6;
  F_CREATEDIR = 7;
  F_EXECUTE = 8;
  F_UPLOAD = 9;
  F_DOWNLOAD = 10;
  F_SEARCH = 11;

procedure TFiles.DoUpload(FileName: string);
var
  dwFileLen: dword;
  CommandFrame: TCommandFrame;
  ReplyStream: TMemoryStream;
  FileStream: TMemoryStream;
begin
  if not SocketConnected then Exit;
  SetCurrentDirectory(PChar(ExtractFilePath(FileName)));
  ComboBox1.Enabled := False;
  Downloading := True;
  FileStream := TMemoryStream.Create;
  FileStream.LoadFromFile(FileName);
  FileName := CurrentDirectory + ExtractFileName(FileName);
  dwFileLen := Length(FileName);
  CommandFrame.len := SizeOf(dword) + dwFileLen + FileStream.Size;
  CommandFrame.Command := F_UPLOAD;
  CommandFrame.ID := FRAME_ID;
  ReplyStream := TMemoryStream.Create;
  ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
  ReplyStream.WriteBuffer(dwFileLen, SizeOf(dword));
  ReplyStream.WriteBuffer(Pointer(FileName)^, dwFileLen);
  ReplyStream.CopyFrom(FileStream, 0);
  FileStream.Free;
  Main.SendStream(DataSocket, ReplyStream);
end;

procedure TFiles.WMDROPFILES(var Msg: Messages.TMessage);
var
  pcFileName: PChar;
  iSize: Integer;
begin
  iSize := DragQueryFile(Msg.wParam, 0, nil, 0) + 1;
  pcFileName := StrAlloc(iSize);
  DragQueryFile(Msg.wParam, 0, pcFileName, iSize);
  DoUpload(string(pcFileName));
  StrDispose(pcFileName);
  DragFinish(Msg.wParam);
end;

procedure TFiles.WindowProc(var Message: Messages.TMessage);
begin
  if Message.Msg = WM_DROPFILES then WMDROPFILES(Message);
  OldWindowProc(Message);
end;

function TFiles.SocketConnected: Boolean;
begin
  if ((Connected) and (DataSocket <> nil)) then
  begin
    Connected := DataSocket.Connected;
    if not Connected then Label1.Caption := ' 断开连接: ';
  end;
  Result := Connected;
end;

function FileSize(SizeInBytes: dword): string;
const
  Formats: array[0..3] of string = (' Bytes', ' KB', ' MB', ' GB');
  FormatSpecifier: array[Boolean] of string = ('%n', '%.2n');
var
  iLoop: Integer;
  TempSize: Real;
begin
  iLoop := -1;
  TempSize := SizeInBytes;
  while (iLoop <= 3) do
  begin
    TempSize := TempSize / 1024;
    Inc(iLoop);
    if Trunc(TempSize) = 0 then
    begin
      TempSize := TempSize * 1024;
      Break;
    end;
  end;
  Result := Format(FormatSpecifier[((Frac(TempSize) * 10) > 1)], [TempSize]);
  if Copy(Result, Length(Result) - 2, 3) = '.00' then
    Result := Copy(Result, 1, Length(Result) - 3);
  Result := Result + Formats[iLoop];
end;

function FileTimeToDateTimeStr(F: TFileTime): string;
var
  LocalFileTime: TFileTime;
  SystemTime: TSystemTime;
  DateTime: TDateTime;
begin
  if Comp(F) = 0 then Result := '-'
  else
  begin
    LongTimeFormat := 'h:mm AMPM';
    FileTimeToLocalFileTime(F, LocalFileTime);
    FileTimeToSystemTime(LocalFileTime, SystemTime);
    with SystemTime do
      DateTime := EncodeDate(wYear, wMonth, wDay) +
        EncodeTime(wHour, wMinute, wSecond, wMilliseconds);
    Result := DateTimeToStr(DateTime);
    if Length(Result) <= Length('mm/dd/yyyy') then Result := Result + ' 12:00 AM';
  end;
end;

procedure TFiles.Connect(var Socket: TCustomWinSocket; Data: Pointer);
var
  Files: TFiles;
  ConnectionInfo: TConnectionInfo;
begin
  Files := TFiles(Data);
  if TStreamRecord(Socket.Data).LocalAddress <> Files.RemoteAddress then Exit;
  if Files.DataSocket = nil then Files.DataSocket := Socket else Exit;
  Files.SearchWindow.DataSocket := Socket;
  ConnectionInfo.ConnectionType := F_TYPE;
  Socket.SendBuf(ConnectionInfo, SizeOf(TConnectionInfo));
  Files.Connected := True;
 // Files.Label3.Caption := ' 已连接: ' + Socket.RemoteAddress;
  Files.ComboBox1.Enabled := True;
  Files.ListView1.Cursor:=crDefault;
  Files.Refresh1Click(nil);
  Socket := nil;
end;

procedure TFiles.Read(var Socket: TCustomWinSocket; CommandFrame: TCommandFrame; Stream: TMemoryStream; Data: Pointer);
var
  Files: TFiles;
  PBuffer, Buffer: PChar;
  TypeBuffer: Pointer;
  Count, BufferSize, DriveCount: dword;
  DriveType: string;
  FindData: TWIN32FindData;
  ListItem: TListItem;
  Attributes: string;
  Save: TSaveDialog;
  FileStream: TFileStream;
  FileName: string;
  FilePath: string;
  I: Integer;
  Temp: string;
  flex: string;
begin
  Files := TFiles(Data);
  if Files.DataSocket = Socket then
  begin
    try
      case CommandFrame.Command of
        F_DRIVES:
          begin
            Stream.ReadBuffer(BufferSize, 4);
            GetMem(Buffer, BufferSize);
            Stream.ReadBuffer(Buffer^, BufferSize);
            Stream.ReadBuffer(DriveCount, 4);
            GetMem(TypeBuffer, DriveCount);
            Stream.ReadBuffer(TypeBuffer^, DriveCount);
            PBuffer := Buffer;
            Count := 0;
            while PBuffer^ <> #0 do
            begin
              Inc(Count);
              case dword(Pointer(dword(TypeBuffer) + ((Count - 1) * 4))^) of
                DRIVE_UNKNOWN: DriveType := '未知';
                DRIVE_NO_ROOT_DIR: DriveType := '未知型号';
                DRIVE_REMOVABLE: DriveType := '软盘';
                DRIVE_FIXED: DriveType := '磁盘';
                DRIVE_REMOTE: DriveType := 'Remote';
                DRIVE_CDROM: DriveType := 'CDROM';
                DRIVE_RAMDISK: DriveType := 'RAMDISK';
              end;
              Files.ComboBox1.Items.Add(string(PBuffer) + ' (' + DriveType + ')');
              Inc(PBuffer, Length(PBuffer) + 1);
            end;
          end;
        F_LIST:
          begin
            Files.ListView2.Clear;
            Files.ListView1.Clear;
            Files.ComboBox1.Enabled := True;
            if Stream.Size = 0 then Exit;
            Files.ListView2.Items.BeginUpdate;
            Files.ListView1.Items.BeginUpdate;
            while Stream.Position < Stream.Size do
            begin
              Stream.Read(FindData, SizeOf(TWIN32FindData));
              if ((FindData.dwFileAttributes and faDirectory) <> 0) then
              begin
                ListItem := Files.ListView2.Items.Add;
                ListItem.Caption := string(FindData.cFileName);
              end
              else
              begin