一
一剑飘雪
Unregistered / Unconfirmed
GUEST, unregistred user!
程序Ａ：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPServer;
type
TData = record
Command,
HD: string[200];
FileName: TStringList;
end;
type
TForm1 = class(TForm)
IdTCPServer1: TIdTCPServer;
GroupBox1: TGroupBox;
Memo1: TMemo;
procedure IdTCPServer1Connect(AThread: TIdPeerThread);
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
private
function GetHD: string;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function TForm1.GetHD: string;
var
D: DWORD;
I: Integer;
S: string;
Buffer: array[0..255] of char;
begin
S := '';
D := GetLogicalDriveStrings(225, Buffer);
for I := 0 to (D - 1) do
begin
if Buffer = #0 then
begin
S := Copy(S, 0, Length(S) - 1);
Result := Result + ' ' + S;
S := '';
end else
S := S + Buffer;
end;
end;
procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
begin
Memo1.Lines.Add('Connect..OK');
end;
procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
Data: TData;
begin
Data.FileName.Create;
Data.FileName.Add('a');
Data.FileName.Add('b');
if (not AThread.Terminated) and (AThread.Connection.Connected) then
begin
AThread.Connection.ReadBuffer(Data, SizeOf(Data));
Memo1.Lines.Add('Command : ' + Data.Command);
if Data.Command = 'HD' then
begin
Data.HD := GetHD;
AThread.Connection.WriteBuffer(Data, SizeOf(Data), True);
Exit;
end;
if Data.Command = 'GetFileList' then
begin
Exit;
end;
end;
end;
end.
程序Ｂ：
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient;
type
TData = record
Command,
HD: string[200];
FileName: TStringList;
end;
type
TForm2 = class(TForm)
IdTCPClient1: TIdTCPClient;
GroupBox1: TGroupBox;
ListView1: TListView;
Button1: TButton;
GroupBox2: TGroupBox;
ComboBox1: TComboBox;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TClientHandleThread = class(TThread)
private
Data: TData;
protected
procedure Execute; override;
end;
var
Form2: TForm2;
ClientHandleThread: TClientHandleThread;
implementation
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
begin
IdTCPClient1.Connect(10000);
ClientHandleThread := TClientHandleThread.Create(True);
ClientHandleThread.FreeOnTerminate := True;
ClientHandleThread.Resume;
end;
procedure TForm2.Button2Click(Sender: TObject);
var
Data:TData;
begin
Data.Command := ComboBox1.Text;
IdTCPClient1.WriteBuffer(Data, SizeOf(Data), True);
end;
{ TClientHandleThread }
procedure TClientHandleThread.Execute;
begin
Data.FileName.Create;
while not Terminated do
begin
if not Form2.IdTCPClient1.Connected then
Terminate
else try
Form2.IdTCPClient1.ReadBuffer(Data, SizeOf(Data));
if Data.Command = 'HD' then
begin
Form2.ListView1.Items.Add.Caption := Data.HD;
Exit;
end;
if Data.Command = 'GetFileList' then
begin
Form2.ListView1.Items.Add.Caption := Data.FileName.Names[1];
Exit;
end;
except
end;
end;
end;
end.
如果把里面的TStringList去掉的话，就没有问题了！
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPServer;
type
TData = record
Command,
HD: string[200];
FileName: TStringList;
end;
type
TForm1 = class(TForm)
IdTCPServer1: TIdTCPServer;
GroupBox1: TGroupBox;
Memo1: TMemo;
procedure IdTCPServer1Connect(AThread: TIdPeerThread);
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
private
function GetHD: string;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function TForm1.GetHD: string;
var
D: DWORD;
I: Integer;
S: string;
Buffer: array[0..255] of char;
begin
S := '';
D := GetLogicalDriveStrings(225, Buffer);
for I := 0 to (D - 1) do
begin
if Buffer = #0 then
begin
S := Copy(S, 0, Length(S) - 1);
Result := Result + ' ' + S;
S := '';
end else
S := S + Buffer;
end;
end;
procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
begin
Memo1.Lines.Add('Connect..OK');
end;
procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
Data: TData;
begin
Data.FileName.Create;
Data.FileName.Add('a');
Data.FileName.Add('b');
if (not AThread.Terminated) and (AThread.Connection.Connected) then
begin
AThread.Connection.ReadBuffer(Data, SizeOf(Data));
Memo1.Lines.Add('Command : ' + Data.Command);
if Data.Command = 'HD' then
begin
Data.HD := GetHD;
AThread.Connection.WriteBuffer(Data, SizeOf(Data), True);
Exit;
end;
if Data.Command = 'GetFileList' then
begin
Exit;
end;
end;
end;
end.
程序Ｂ：
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient;
type
TData = record
Command,
HD: string[200];
FileName: TStringList;
end;
type
TForm2 = class(TForm)
IdTCPClient1: TIdTCPClient;
GroupBox1: TGroupBox;
ListView1: TListView;
Button1: TButton;
GroupBox2: TGroupBox;
ComboBox1: TComboBox;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TClientHandleThread = class(TThread)
private
Data: TData;
protected
procedure Execute; override;
end;
var
Form2: TForm2;
ClientHandleThread: TClientHandleThread;
implementation
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
begin
IdTCPClient1.Connect(10000);
ClientHandleThread := TClientHandleThread.Create(True);
ClientHandleThread.FreeOnTerminate := True;
ClientHandleThread.Resume;
end;
procedure TForm2.Button2Click(Sender: TObject);
var
Data:TData;
begin
Data.Command := ComboBox1.Text;
IdTCPClient1.WriteBuffer(Data, SizeOf(Data), True);
end;
{ TClientHandleThread }
procedure TClientHandleThread.Execute;
begin
Data.FileName.Create;
while not Terminated do
begin
if not Form2.IdTCPClient1.Connected then
Terminate
else try
Form2.IdTCPClient1.ReadBuffer(Data, SizeOf(Data));
if Data.Command = 'HD' then
begin
Form2.ListView1.Items.Add.Caption := Data.HD;
Exit;
end;
if Data.Command = 'GetFileList' then
begin
Form2.ListView1.Items.Add.Caption := Data.FileName.Names[1];
Exit;
end;
except
end;
end;
end;
end.
如果把里面的TStringList去掉的话，就没有问题了！