⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 使用delphi6开发的TCP/IP下文件服务器程序
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, Menus, StdCtrls, ComCtrls,FileCtrl, ImgList,IniFiles,
  WinSkinStore, WinSkinData;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Listen1: TMenuItem;
    listenItem: TMenuItem;
    connectItem: TMenuItem;
    disconnectItem: TMenuItem;
    ClientSocket: TClientSocket;
    ServerSocket: TServerSocket;
    exitItem: TMenuItem;
    Searchseting1: TMenuItem;
    DirSetting1: TMenuItem;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    Edit_filename: TEdit;
    Label_Result: TLabel;
    GO: TButton;
    ListBox1: TListBox;
    ShowDirInfo1: TMenuItem;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    DirectoryListBox: TDirectoryListBox;
    TreeView: TTreeView;
    ImageList1: TImageList;
    sd1: TSkinData;
    sd2: TSkinData;
    SkinStore1: TSkinStore;
    procedure listenItemClick(Sender: TObject);
    procedure connectItemClick(Sender: TObject);
    procedure exitItemClick(Sender: TObject);
    procedure DirSetting1Click(Sender: TObject);
    procedure ServerSocketAccept(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ShowDirInfo1Click(Sender: TObject);
    procedure ServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormResize(Sender: TObject);
    procedure GOClick(Sender: TObject);
    procedure TreeViewChange(Sender: TObject; Node: TTreeNode);
    procedure GOKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }

    file_prefix:string ;
    op_type:string;
    strDir:string;
    IsServer:boolean;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.listenItemClick(Sender: TObject);
begin

 ListenItem.Checked := not ListenItem.Checked;
 if ListenItem.Checked then
 begin
  ClientSocket.Active := False;
  ServerSocket.Active := True;
 end
else
  begin
   if ServerSocket.Active then
   ServerSocket.Active := False;
  end;

end;

procedure TForm1.connectItemClick(Sender: TObject);
var
Server:string;
begin
if ClientSocket.Active then ClientSocket.Active := False;
server:='lx';
if InputQuery('Computer to connect to', 'Address Name:', Server) then
if Length(Server) > 0 then
with ClientSocket do
begin
Host := Server;
Active := True;
ListenItem.Checked := False;
end;

end;

procedure TForm1.exitItemClick(Sender: TObject);
begin

close;
end;

procedure TForm1.DirSetting1Click(Sender: TObject);
var
Dir:string;
begin
if ClientSocket.Active then
 begin
  Dir:='f:\';
  if InputQuery('Directory to connect to', 'Directory Name:', Dir) then
    begin
   if Length(Dir) > 0 then
    strDir:=Dir;
    end;
  op_type:='1';  
  ClientSocket.Socket.SendText(op_type+strDir);
 end;
end;
procedure TForm1.ServerSocketAccept(Sender: TObject;
  Socket: TCustomWinSocket);
begin
 IsServer:=true;
 ListenItem.Checked := not ListenItem.Checked;

end;

procedure TForm1.ShowDirInfo1Click(Sender: TObject);

begin
 if ClientSocket.Active then
 begin
     op_type:='2';
     ClientSocket.Socket.SendText(op_type+strDir);
     pagecontrol1.ActivePageIndex:=1;
 end;
end;

procedure TForm1.ServerSocketClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
strDir:string;
Data:WIN32_FIND_DATA;
hFile:Cardinal;
rectxt:string;
msg,filename:string;
begin
  if ServerSocket.Active then
 begin
  rectxt:=socket.ReceiveText;
  self.op_type:=copy(rectxt,1,1);
  if op_type='1' then
   begin
    strDir:=copy(rectxt,2,length(rectxt)-1);
    ChDir(strDir);
    exit;
   end;

  if op_type='2' then
   begin

    strDir:=copy(rectxt,2,length(rectxt)-1);
    ChDir(strDir);
    hFile:=findfirstfile('*.*',Data);
    if (hFile<>INVALID_HANDLE_VALUE) then
    begin
     DirectoryListBox.Directory:= strDir;
     msg:='2';
     repeat
     begin
     filename:=Data.cFileName;
     if (filename<>'.' )and(filename<>'..') then

        msg:=msg+Data.cFileName+file_prefix;

     end
      until(findnextfile(hFile,Data)=false);
     Socket.SendText(msg);

    end;
    exit;
   end ;
   if op_type='3' then
   begin
    ChDir(strDir);
    filename:=copy(rectxt,2,length(rectxt)-1);
    hFile:=findfirstfile(pchar(filename),Data);
    if (hFile<>INVALID_HANDLE_VALUE) then
    begin
       begin
       msg:='3' ;
       Socket.SendText(msg+'yes');
      end;
    end
    else
      begin
       msg:='3';
       Socket.SendText(msg+'no');
      end;
    exit;
   end;

 end;
end;

procedure TForm1.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
strDirInfo:string;
strSubDir:string;
rectxt:string;

rootchildnode,chlidNode:ttreeNode;
begin


  rectxt:=socket.ReceiveText;
  op_type:=copy(rectxt,1,1);


  if op_type='2' then
   begin

    strDirInfo:=copy(rectxt,2,length(rectxt)-1);
    treeview.Items.Clear;
    rootchildnode:=treeview.Items.AddChild(nil,strdir);
    rootchildnode.ImageIndex:=0;
     repeat
     begin
        strSubDir:=copy(strDirInfo,1,pos('?',strDirInfo)-1);
        strDirInfo:=copy(strDirInfo,pos('?',strDirInfo)+1,length(strDirInfo)-pos('?',strDirInfo));
        chlidNode:=treeview.Items.AddChild(rootchildnode,strSubDir);
        if pos('.',strSubDir)>0  then

        chlidNode.ImageIndex:=2
        else

        chlidNode.ImageIndex:=1;
     end
     until(strDirInfo='');

     
     exit;

   end;
   if op_type='3' then
   begin
      strDirInfo:=copy(rectxt,2,length(rectxt)-1);
      if strDirInfo='yes' then
       begin
        listbox1.Clear;
        listbox1.Items.Add('have found!') ;
       end
       else
        begin
        listbox1.Clear;
        listbox1.Items.Add('haven''t found!') ;
       end;

   end;

end;

procedure TForm1.FormCreate(Sender: TObject);
var
 IniFile: TIniFile;
 SkinItemId:integer;
begin
   file_prefix:='?';
   op_type:='0';

   SkinItemId:=0;
   try
   IniFile:=TIniFile.Create('.\config.ini');
   SkinItemId:=strtoint(IniFile.ReadString('Skin','SkinItemId',''));
   Inifile.Free;
   except
     
     IniFile.WriteString('Skin','SkinItemId','4');
     Inifile.Free;
   end;
   if ( SkinItemId>0) and (SkinItemId<5)   then
   Sd2.LoadFromCollection(skinstore1,SkinItemId)
   else
   Sd2.LoadFromCollection(skinstore1,0);

   Sd1.LoadFromCollection(skinstore1,4);
   
   if not sd1.active then sd1.active:=true;
   self.PageControl1.ActivePageIndex:=0;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 if ServerSocket.Active then

  self.ServerSocket.Close;
 if ClientSocket.Active then

  self.ClientSocket.Close;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  self.PageControl1.Width:=self.Width-250;
  listbox1.Height:=self.Height-250;
end;

procedure TForm1.GOClick(Sender: TObject);
begin
 if ClientSocket.Active then
 begin
     op_type:='3';
     ClientSocket.Socket.SendText(op_type+edit_filename.Text);
     pagecontrol1.ActivePageIndex:=1;
 end;
end;

procedure TForm1.TreeViewChange(Sender: TObject; Node: TTreeNode);
begin
  edit_filename.Text:=treeview.Selected.Text;
 
end;

procedure TForm1.GOKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if key=vk_return then
 begin
  if ClientSocket.Active then
 begin
     op_type:='3';
     ClientSocket.Socket.SendText(op_type+edit_filename.Text);
     pagecontrol1.ActivePageIndex:=1;
 end;
 end;

end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -