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

📄 unit1.pas

📁 确的目录
💻 PAS
📖 第 1 页 / 共 2 页
字号:
begin
  OpenDialog1.InitialDir := path+'skins\';
  OpenDialog1.FileName := '';
  if OpenDialog1.Execute then
  if OpenDialog1.FileName <> '' then
     bsSkinData1.LoadFromFile(OpenDialog1.FileName);
end;

procedure TForm1.bsSkinListBox1ListBoxClick(Sender: TObject);
var
  i: integer;
begin
  if bsSkinListBox1.Items.Count <> 0 then
  begin
     bsSkinButton3.Enabled := true;
     bsSkinEdit1.Text := bsSkinListBox1.Items[bsSkinListBox1.ItemIndex];
     i := 1;
     while i < length(bsSkinEdit1.Text) do
     begin
       if copy(bsSkinEdit1.Text,i,1) = '-' then
          break;
       i := i + 1;
     end;
     desIP := copy(bsSkinEdit1.Text,1,i-1);
     if trans=false then
     begin
       ClientSocket1.Close;
       ClientSocket2.Close;
       ClientSocket1.Address:=desIP;
       ClientSocket2.Address:=desIP;
       ClientSocket1.Open;
       ClientSocket2.Open;
     end;
  end
  else
  begin
     bsSkinButton3.Enabled := false;
     bsSkinEdit1.Text := '';
  end;
end;

procedure TForm1.bsSkinEdit1Change(Sender: TObject);
begin
  if bsSkinEdit1.Text = '' then
     bsSkinMemo1.Enabled := false
  else
     bsSkinMemo1.Enabled := True;
end;

procedure TForm1.bsSkinButton1Click(Sender: TObject);
begin
  IdUDPClient2.Host := desIP;
  IdUDPClient2.Send(HostIp+'--'+Hostname+' 对你说:');
  IdUDPClient2.Send('         '+bsSkinMemo1.Text);
  bsSkinMemo2.Lines.Add('你对 '+bsSkinEdit1.Text+' 说:');
  bsSkinMemo2.Lines.Add('         '+bsSkinMemo1.Text);
  bsSkinMemo1.Text := '';
end;

procedure TForm1.IdUDPServer2UDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
  s: string;
begin
  SetLength(s, AData.Size);
  AData.Read(s[1], AData.Size);
  bsSkinMemo2.Lines.Add(s);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  Form1.Width := 567;
  Form1.Height := 427;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
  form3.showmodal;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
  SaveDialog1.InitialDir := path;
  SaveDialog1.FileName := 'chat.txt';
  if SaveDialog1.Execute then
  begin
     bsSkinMemo2.Lines.SaveToFile(SaveDialog1.FileName);
  end;
end;

procedure TForm1.N8Click(Sender: TObject);
begin
  OpenDialog1.InitialDir := path+'skins\';
  OpenDialog1.FileName := '';
  if OpenDialog1.Execute then
  if OpenDialog1.FileName <> '' then
     bsSkinData1.LoadFromFile(OpenDialog1.FileName);
end;

procedure TForm1.N9Click(Sender: TObject);
begin
  form3.showmodal;

end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  s:string;
  i,j,len:integer;
  sourceIP:string;
begin
  s:=Socket.ReceiveText;
  len:=length(s);
  if copy(s,1,3)='ask' then
  begin
    s:=copy(s,4,len-3);
    i:=1;
    j:=1;
    while true do
    begin
      if copy(s,j,1)='-' then break;
      j:=j+1;
    end;
    while true do
    begin
      if copy(s,i,1)=';' then break;
      i:=i+1;
    end;
    sourceIP:=copy(s,1,j-1);
    len:=length(s);
    if Application.MessageBox(PAnsiChar('用户 '+copy(s,1,i-1)+' 要传文件给你,是否接收?'),'提示',MB_YESNO+MB_ICONQUESTION)=ID_YES then
    begin
      SaveDialog1.FileName:=copy(s,i+1,len-i);
      if SaveDialog1.Execute then
         Socket.SendText('Ready')  //准备接收
      else
         Socket.SendText('ansNo')  //不接收
    end
    else
      Socket.SendText('ansNo');   //不接收
  end;
end;

procedure TForm1.bsSkinButton3Click(Sender: TObject);
begin
  bsSkinButton5.Enabled:=false;
  if OpenDialog2.Execute then
  begin
     ClientSocket1.Socket.SendText('ask'+HostIp+'-'+Hostname+';'+ExtractFileName(OpenDialog2.FileName));
     Application.MessageBox('信息已经发出,等待对方应答!','提示',MB_OK);
  end
end;

procedure TForm1.ServerSocket2ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var RealCount:integer;
   FileInfo:string;
   Buff:Pointer;
   i,len:integer;
begin
  if (not FilenfoReceived) then
  begin
     bsSkinLabel2.Caption:='';
     Timer2.Interval:=1000;
     FilenfoReceived:=true;
     FileInfo:=socket.ReceiveText;
     i:=1;
     len:=length(FileInfo);;
     while true do
     begin
       if copy(FileInfo,i,1)='/' then break;
       i:=i+1;
     end;
     FileName:=copy(FileInfo,1,i-1); //服务端发送的文件名与文件长度之间有一“/”
     FileSize:=StrToInt(copy(FileInfo,i+1,len-i));
     bsSkinGauge1.MaxValue:=FileSize;
     //建立目标文件
     DestFileStream:=TFileStream.Create(ExtractFileName(FileName),fmCreate or fmOpenWrite);
  end
  else
  begin
    //开始接收文件
     getmem(buff,datasize);
     RealCount:=Socket.ReceiveBuf(Buff^,datasize);
     DestFileStream.WriteBuffer(Buff^,RealCount);  //将接收到的文件内容写入目标文件
     bsSkinGauge1.Value:=DestFileStream.Size;
     Socket.SendText('Ready');  //返回一条信息,准备接收后续数据
     freemem(buff);
     if DestFileStream.size>=FileSize then
     begin
        Timer2.Interval:=0;
        DestFileStream.Free;
        FilenfoReceived:=false;
        Socket.SendText('Over');
        trans:=false;
        Application.MessageBox('文件传送成功完成!','提示',MB_OK);
        bsSkinGauge1.Value:=0;
     end;
  end;

end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
var
  s: string;
begin
  s:=Socket.ReceiveText;
  if s='ansNo' then
  begin
     Application.MessageBox('对方不愿意接收文件!','提示',MB_OK);
     bsSkinButton5.Enabled:=false;
  end;
  If s='Ready' then
  begin
     Application.MessageBox('对方已准备接收,请发送!','提示',MB_OK);
     bsSkinButton5.Enabled:=true;
  end;
end;

procedure TForm1.bsSkinButton5Click(Sender: TObject);
var
  s: string;
begin
    trans:=true;
    fs:=TFileStream.Create(OpenDialog2.FileName,fmOpenRead);
     //获取文件大小
    FileSize:=GetFileSize(OpenDialog2.FileName);
    bsSkinGauge1.MaxValue:=FileSize;
    bsSkinGauge1.MinValue:=0;
    bsSkinGauge1.Value:=0;
    bsSkinLabel2.Caption:='';
    CostTime:=0;
    Timer2.Interval:=1000;
    //先发文件名与字节数
    s:=ExtractFileName(OpenDialog2.FileName)+'/'+InttoStr(FileSize);
    ClientSocket2.Socket.SendText(s);
    //开始发送文件
    getmem(buff,datasize);
    //RealCoun为实际读取的字节数
    RealCount:=fs.Read(buff^,datasize);
    ClientSocket2.socket.sendbuf(buff^,RealCount);
    bsSkinButton3.Enabled:=false;
    bsSkinButton5.Enabled:=false;
end;

procedure TForm1.ClientSocket2Read(Sender: TObject;
  Socket: TCustomWinSocket);
var
  s:string;
begin
  s:=Socket.ReceiveText;
  if s='Ready' then
  begin
    getmem(buff,datasize);
    RealCount:=fs.Read(buff^,datasize);
    bsSkinGauge1.Value:=fs.Position;
    ClientSocket2.socket.sendbuf(buff^,RealCount);
  end;
  if s='Over' then
  begin
     Timer2.Interval:=0;
     bsSkinButton5.Enabled:=false;
     bsSkinButton3.Enabled:=true;
     freemem(buff,DataSize);
     fs.Free;
     Application.MessageBox('文件传送成功完成!','提示',MB_OK);
     bsSkinGauge1.Value:=0;
  end;

end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
  CostTime:=CostTime+1;
  bsSkinLabel2.Caption:=IntToStr(CostTime);
  bsSkinLabel2.Refresh;
end;

end.

⌨️ 快捷键说明

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