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

📄 u_mainfrm.pas

📁 使用delphi编写的简单socket请求发送工具TCP协议
💻 PAS
📖 第 1 页 / 共 2 页
字号:
   ip_str_tmp3 := IntToStr(Third_IPAddress(ip));
   ip_str_tmp4 := IntToStr(Fourth_IPAddress(ip));

   ip_str := ip_str_tmp1 + '.' +  ip_str_tmp2 + '.' +  ip_str_tmp3 + '.' +
                  ip_str_tmp4;

   ip_str := ip_str + '@' + edt_Port.Text;
   m_Set.WriteString('ADDRCONF', ip_str , '');
 end;
end;

procedure Tfrm_Main.cmb_timesKeyPress(Sender: TObject; var Key: Char);
begin
 if not(Key in ['0'..'9',#8]) then key:=#0; 
end;

procedure Tfrm_Main.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  m_Set.WriteBool('SYSTEM','LONGLINK',chk_Long.Checked);
  m_Infos.f_ClearData;
  stop := true;
  Application.ProcessMessages;
  m_Infos.Free;
end;


procedure f_InsertCompToStatuBar(p_Bar: TStatusBar; p_Control: TControl;
                                 p_Pos: Shortint);
var
  v_PanelRect: TRect;
begin
  CHackControl(p_Control).SetParent(p_Bar);
  SendMessage(p_Bar.Handle, SB_GETRECT, p_Pos, Integer(@v_PanelRect));
  p_Control.SetBounds(v_PanelRect.Left + 1,
                       v_PanelRect.Top + 1,
                       v_PanelRect.Right  - v_PanelRect.Left - 2,
                       v_PanelRect.Bottom - v_PanelRect.Top  - 2);
end;

procedure Tfrm_Main.FormCreate(Sender: TObject);
var
  ip: Integer;
begin
  v_IPEdit := TIpEdit.Create(Application);
  v_IPEdit.Parent := edt_IPFalse.Parent;
  v_IPEdit.BoundsRect := edt_IPFalse.BoundsRect;

  SetWindowLong(edt_Port.Handle,GWL_Style,
                (GetWindowLong(edt_Port.Handle,GWL_Style) or ES_Number or ES_RIGHT));

  m_Infos :=  TSendInfo.Create;
  lv_Result.Items.Count := m_Infos.f_GetCount();
  lv_Result.Repaint;

  stop := false;

  m_Set := TIniFile.Create(ExtractFilePath(Application.ExeName)+'Params.ini');
  edt_Port.Text  := m_Set.ReadString('SYSTEM', 'PORT', '0');
  ip:=MAKEIPADDRESS(m_Set.ReadInteger('SYSTEM','HOST1',0),
                    m_Set.ReadInteger('SYSTEM','HOST2',0),
                    m_Set.ReadInteger('SYSTEM','HOST3',0),
                    m_Set.ReadInteger('SYSTEM','HOST4',0));
  SendMessage(v_IPEdit.Handle,IPM_SETADDRESS,0,ip);

  chk_Long.Checked := m_Set.ReadBool('SYSTEM','LONGLINK',False);
end;

function Tfrm_Main.f_GetIP: string;
var
  ip: Integer;
  IP1, IP2, IP3, IP4:  ShortString;
begin
  SendMessage(v_IPEdit.Handle,IPM_GETADDRESS, 0, Integer(@ip));
  IP1 := IntToStr(First_IPAddress(ip));
  IP2 := IntToStr(Second_IPAddress(ip));
  IP3 := IntToStr(Third_IPAddress(ip));
  IP4 := IntToStr(Fourth_IPAddress(ip));
  Result :=  IP1 + '.' + IP2 + '.' + IP3 + '.' + IP4
end;

function Tfrm_Main.initWinSocket(v_host: string; v_port: Integer):boolean;
var
  v_wsData:  TWSAData;
  v_sockfd:  integer;
  v_svrAddr: TSockAddr;
begin
  Result := False;
  WSAStartup(MakeWord(2,0),v_wsData);
  v_sockfd := socket(AF_INET, SOCK_STREAM, 0);
  if v_sockfd = -1 then
  begin
   Application.MessageBox('Socket创建失败!', '错误',
                          MB_OK + MB_ICONERROR);
   WSAcleanup;
   exit;
  end;
  v_svrAddr.sin_family := AF_INET;
  v_svrAddr.sin_port := htons(v_port);
  v_svrAddr.sin_addr.S_addr := Inet_Addr(PChar(v_host));
  FillChar(v_SvrAddr.sin_zero, SizeOf(v_svrAddr.sin_zero), 0);

  if connect(v_sockfd, v_SvrAddr, SizeOf(v_SvrAddr)) = -1 then
  begin
    Application.MessageBox('Socket连接失败!', '错误',
                           MB_OK + MB_ICONERROR);
    if CloseSocket(v_sockfd) <> 0 then
    begin
      Application.MessageBox('CloseSocket失败!', '错误',
                             MB_OK + MB_ICONERROR);
    end;

    Exit;
  end;

  sockfd := v_sockfd;
  Result := True;
end;

procedure Tfrm_Main.lv_ResultCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  with TListView(Sender).Canvas.Brush do
  begin
    Color := c_Colors[Odd(Item.Index)];
  end;
end;

procedure Tfrm_Main.lv_ResultData(Sender: TObject; Item: TListItem);
begin
  if m_Infos.f_GetDate(Item.Index) = nil then Exit;
  Item.SubItems.Add(m_Infos.f_GetDate(Item.Index)^.r_String);
  Item.SubItems.Add(m_Infos.f_GetDate(Item.Index)^.r_Result);
  Item.ImageIndex := m_Infos.f_GetDate(Item.Index)^.r_Stat;
end;

procedure Tfrm_Main.lv_ResultMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  v_Item: TListItem;
begin
  v_Item := lv_Result.GetItemAt(X, Y);
  if v_Item <> nil then
  begin
    if m_Infos.f_GetDate(v_Item.Index) = nil then
    begin
      mm_Test.Clear;
      edt_Result.Text := '';
    end else
    begin
      mm_Test.Text := m_Infos.f_GetDate(v_Item.Index)^.r_String;
      edt_Result.Text := m_Infos.f_GetDate(v_Item.Index)^.r_Result;
    end;
  end;
end;

procedure Tfrm_Main.mi_CloseClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure Tfrm_Main.mm_ContentDblClick(Sender: TObject);
begin
  mm_Content.Clear;
end;

procedure Tfrm_Main.SpeedButton1Click(Sender: TObject);
var
  v_Frm: Tfrm_AddConf;
  v_IP: TStringList;
  ip: Integer;
  ip1,ip2,ip3,ip4: Integer;
begin
  v_Frm := Tfrm_AddConf.Create(Application);
  try
    v_Frm.ShowModal;

    if Length(Trim(v_Frm.m_IP + v_Frm.m_Port)) <> 0 then
    begin
    v_IP := TStringList.Create;
    v_IP.Delimiter := '.';
    v_IP.DelimitedText := v_Frm.m_IP;
    if v_IP.Count > 3 then
    begin
      if not TryStrToInt(v_IP.Strings[0],ip1) then
      begin
        ip1 := 0;
      end;
      if not TryStrToInt(v_IP.Strings[1],ip2) then
      begin
        ip2 := 0;
      end;
      if not TryStrToInt(v_IP.Strings[2],ip3) then
      begin
        ip3 := 0;
      end;
      if not TryStrToInt(v_IP.Strings[3],ip4) then
      begin
        ip4 := 0;
      end;
      ip:=MAKEIPADDRESS(ip1,ip2,ip3,ip4);
      SendMessage(v_IPEdit.Handle,IPM_SETADDRESS,0,ip);

      edt_Port.Text := v_Frm.m_Port;
    end;
    v_IP.Free;
    end;
  finally
    v_Frm.Free;
  end;
end;

procedure Tfrm_Main.tm_CountTimer(Sender: TObject);
begin
  stat_Main.Panels.Items[0].Text := '每秒处理约为:' +  IntToStr(new - old) + '条 ';
  if (new - old) <> 0 then
  begin
    stat_Main.Panels.Items[0].Text := stat_Main.Panels.Items[0].Text + '预计结束时间' +
                                      IntToStr((gg_Main.MaxValue-new) div (new - old)) +'秒';
  end;
  old := new;
end;

{ TSendInfo }

constructor TSendInfo.Create();
begin
  inherited;
  m_List := TList.Create;
end;

destructor TSendInfo.Destroy;
begin
  f_ClearData();
  inherited;
end;

procedure TSendInfo.f_AddInfo(p_Infos: string);
var
  v_Ptr: PSendInfo;
begin
  New(v_Ptr);
  v_Ptr^.r_String := p_Infos;
  v_Ptr^.r_Result := '待发送';
  v_Ptr^.r_Stat   := 0;
  m_List.Add(v_Ptr);
end;

procedure TSendInfo.f_ClearData;
var
  v_Count: Integer;
  v_Ptr: PSendInfo;
begin
  for v_Count := 0 to m_List.Count - 1 do
  begin
    v_Ptr := PSendInfo(m_List.Items[v_Count]);
    Application.ProcessMessages;
    Dispose(v_Ptr);
  end;
  m_List.Clear;
end;

function TSendInfo.f_GetCount: Integer;
begin
  Result := m_List.Count;
end;

function TSendInfo.f_GetDate(index: Integer): PSendInfo;
begin
  if index < m_List.Count then
  begin
    Result :=  PSendInfo(m_List.Items[index]);
  end else
    Result := nil;
end;



procedure TSendInfo.f_SetIndex(index, stat: Integer);
begin
  if index < m_List.Count then
  begin
    PSendInfo(m_List.Items[index])^.r_Stat := stat;
  end;
end;

procedure TSendInfo.f_SetReslut(index: Integer; result: string);
begin
  if index < m_List.Count then
  begin
    PSendInfo(m_List.Items[index])^.r_Result := result;
  end;
end;

end.

⌨️ 快捷键说明

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